home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / b / b.lha / B / src / bint / b2cmd.c < prev    next >
Encoding:
C/C++ Source or Header  |  1988-11-24  |  9.3 KB  |  352 lines
  1. /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
  2.  
  3. /*
  4.   $Header: b2cmd.c,v 1.4 85/08/22 16:54:17 timo Exp $
  5. */
  6.  
  7. #include "b.h"
  8. #include "b0fea.h"
  9. #include "b1obj.h"
  10. #include "b2par.h" 
  11. #include "b2key.h"
  12. #include "b2syn.h"
  13. #include "b2nod.h"
  14. #include "b3env.h"
  15. #include "b3err.h"
  16. #include "b3ext.h"
  17.  
  18. /* ******************************************************************** */
  19. /*        command_suite                        */
  20. /* ******************************************************************** */
  21.  
  22. Forward parsetree cmd_seq();
  23.  
  24. Visible parsetree cmd_suite(cil, first) intlet cil; bool first; {
  25.     if (ateol())
  26.         return cmd_seq(cil, first);
  27.     else {
  28.         parsetree v; value c; intlet l= lino;
  29.         suite_command(&v, &c);
  30.         return node5(SUITE, mk_integer(l), v, c, NilTree);
  31.     }
  32. }
  33.  
  34. Hidden parsetree cmd_seq(cil, first) intlet cil; bool first; {
  35.     value c; intlet level, l;
  36.     level= ilev(); l= lino;
  37.     if (is_comment(&c)) 
  38.         return node5(SUITE, mk_integer(l), NilTree, c,
  39.                 cmd_seq(cil, first));
  40.     if ((level == cil && !first) || (level > cil && first)) {
  41.         parsetree v;
  42.         findceol();
  43.         suite_command(&v, &c);
  44.         return node5(SUITE, mk_integer(l), v, c, cmd_seq(level, No));
  45.     }
  46.     veli();
  47.     return NilTree;
  48. }
  49.  
  50. Visible Procedure suite_command(v, c) parsetree *v; value *c; {
  51.     *v= NilTree; *c= Vnil;
  52.     if (!(control_command(v) || simple_command(v, c))) 
  53.         parerr(MESS(2000, "no command where expected"));
  54. }
  55.  
  56. /* ******************************************************************** */
  57. /*        is_comment, tail_line                    */
  58. /* ******************************************************************** */
  59.  
  60. Visible bool is_comment(v) value *v; {
  61.     txptr tx0= tx;
  62.     skipsp(&tx);
  63.     if (comment_sign()) {
  64.         while (Space(Char(tx0-1))) tx0--;
  65.         while (!Eol(tx)) tx++;
  66.         *v= cr_text(tx0, tx);
  67.         return Yes;
  68.     }
  69.     tx= tx0;
  70.     return No;
  71. }
  72.  
  73. Visible value tail_line() {
  74.     value v;
  75.     if (is_comment(&v)) return v;
  76.     if (!ateol()) parerr(MESS(2001, "something unexpected following this line"));
  77.     return Vnil;
  78. }
  79.  
  80. /* ******************************************************************** */
  81. /*        simple_command                        */
  82. /*                                    */
  83. /* ******************************************************************** */
  84.  
  85. Forward bool bas_com(), term_com(), udr_com();
  86.  
  87. Visible bool simple_command(v, c) parsetree *v; value *c; {
  88.     return bas_com(v) || term_com(v) || udr_com(v)
  89.         ? (*c= tail_line(), Yes) : No;
  90. }
  91.  
  92. /* ******************************************************************** */
  93. /*        basic_command                        */
  94. /* ******************************************************************** */
  95.  
  96. Forward value cr_newlines();
  97.  
  98. Hidden bool bas_com(v) parsetree *v; {
  99.     txptr ftx, ttx; parsetree e, t;
  100.     if (check_keyword()) {
  101.             *v= node2(CHECK, test(ceol));
  102.     } else if (choose_keyword()) {
  103.             req(K_FROM_choose, ceol, &ftx, &ttx);
  104.             t= targ(ftx); tx= ttx;
  105.             *v= node3(CHOOSE, t, expr(ceol));
  106.     } else if (delete_keyword()) {
  107.             *v= node2(DELETE, targ(ceol));
  108.     } else if (draw_keyword()) {
  109.             *v= node2(DRAW, targ(ceol));
  110.     } else if (insert_keyword()) {
  111.             req(K_IN_insert, ceol, &ftx, &ttx);
  112.             e= expr(ftx); tx= ttx;
  113.             *v= node3(INSERT, e, targ(ceol));
  114.     } else if (put_keyword()) {
  115.             req(K_IN_put, ceol, &ftx, &ttx);
  116.             e= expr(ftx); tx= ttx;
  117.             *v= node3(PUT, e, targ(ceol));
  118.     } else if (read_keyword()) {
  119.             if (find(K_RAW, ceol, &ftx, &ttx)) {
  120.                 *v= node2(READ_RAW, targ(ftx)); tx= ttx;
  121.                 upto(ceol, K_RAW);
  122.             } else {
  123.                 req(K_EG, ceol, &ftx, &ttx);
  124.                 t= targ(ftx); tx= ttx;
  125.                 *v= node3(READ, t, expr(ceol));
  126.             }
  127.     } else if (remove_keyword()) {
  128.             req(K_FROM_remove, ceol, &ftx, &ttx);
  129.             e= expr(ftx); tx= ttx;
  130.             *v= node3(REMOVE, e, targ(ceol));
  131.     } else if (setrandom_keyword()) {
  132.             *v= node2(SET_RANDOM, expr(ceol));
  133.     } else if (write_keyword()) {
  134.             intlet b_cnt= 0, a_cnt= 0;
  135.             skipsp(&tx);
  136.             if (Ceol(tx))
  137.                 parerr(MESS(2002, "no parameter where expected"));
  138.             while (nwl_sign()) {b_cnt++; skipsp(&tx); }
  139.             if (Ceol(tx)) e= NilTree;
  140.             else {
  141.                 ftx= ceol;
  142.                 while (Space(Char(ftx-1)) || Char(ftx-1) == '/')
  143.                     if (Char(--ftx) == '/') a_cnt++;
  144.                 skipsp(&tx);
  145.                 e= ftx > tx ? expr(ftx) : NilTree;
  146.             }
  147.             *v= node4(WRITE,
  148.                   cr_newlines(b_cnt), e, cr_newlines(a_cnt));
  149.             tx= ceol;
  150.     } else return No;
  151.     return Yes;
  152. }
  153.  
  154. Hidden value cr_newlines(cnt) intlet cnt; {
  155.     value v, t= mk_text("/"), n= mk_integer(cnt);
  156.     v= repeat(t, n);
  157.     release(t); release(n);
  158.     return v;
  159. }
  160.  
  161. /* ******************************************************************** */
  162. /*        terminating_command                    */
  163. /* ******************************************************************** */
  164.  
  165. Visible bool term_com(v) parsetree *v; {
  166.     if (fail_keyword()) {
  167.         upto(ceol, K_FAIL);
  168.         *v= node1(FAIL);
  169.     } else if (quit_keyword()) {
  170.         upto(ceol, K_QUIT);
  171.         *v= node1(QUIT);
  172.     } else if (return_keyword())
  173.         *v= node2(RETURN, expr(ceol));
  174.     else if (report_keyword())
  175.         *v= node2(REPORT, test(ceol));
  176.     else if (succeed_keyword()) {
  177.         upto(ceol, K_SUCCEED);
  178.         *v= node1(SUCCEED);
  179.     } else return No;
  180.     return Yes;
  181. }
  182.  
  183. /* ******************************************************************** */
  184. /*        user_defined_command; refined_command            */
  185. /* ******************************************************************** */
  186.  
  187. Forward value hu_actuals();
  188. #ifdef EXT_COMMAND
  189. Forward bool extended_command();
  190. #endif
  191.  
  192. Hidden bool udr_com(v) parsetree *v; {
  193.     value w;
  194.     if (is_keyword(&w)) {
  195. #ifdef EXT_COMMAND
  196.         if (extended_command(w, v))
  197.             return Yes;
  198. #endif
  199.         if (!in(w, kwlist)) {
  200.             *v= node4(USER_COMMAND,
  201.                 copy(w), hu_actuals(ceol, w), Vnil);
  202.             return Yes;
  203.         }
  204.         release(w);
  205.     }
  206.     return No;
  207. }
  208.  
  209. Hidden value hu_actuals(q, kw) txptr q; value kw; {
  210.     parsetree e; value v, w;
  211.     txptr ftx;
  212.     skipsp(&tx);
  213.     if (!findkw(q, &ftx)) ftx= q;
  214.     e= Text(ftx) ? expr(ftx) : NilTree;
  215.     v= Text(q) ? hu_actuals(q, keyword()) : Vnil;
  216.     w= node5(ACTUAL, kw, e, v, Vnil);
  217.     return w;
  218. }
  219.  
  220. #ifdef EXT_COMMAND
  221.  
  222. /* ******************************************************************** */
  223. /*        extended_command                    */
  224. /* ******************************************************************** */
  225.  
  226. Hidden bool extended_command(w, v) value w, *v; {
  227.     string name, arg; ext *e; int i; value args[MAXEARGS], a;
  228.     txptr ftx, ttx;
  229.     extern bool extcmds; /* Flag set in main by -E option */
  230.     if (!extcmds) return No;
  231.     name= strval(w);
  232.     for (e= extensions; e->e_name != 0; ++e) {
  233.         if (strcmp(e->e_name, name) == 0) break;
  234.     }
  235.     if (e->e_name == 0) return No;
  236.     for (i= 0; i < MAXEARGS && (arg= e->e_args[i]) != 0; ++i) {
  237.         if (arg[1] != '\0') req(arg+1, ceol, &ftx, &ttx);
  238.         else ftx= ceol;
  239.         switch (arg[0]) {
  240.         case 'e': args[i]= expr(ftx); break;
  241.         case 't': args[i]= targ(ftx); break;
  242.         default: psyserr(MESS(2003, "bad entry in extended_command table"));
  243.         }
  244.         if (arg[1] != '\0') tx= ttx;
  245.     }
  246.     if (i == 0) arg= e->e_name;
  247.     else {
  248.         arg= e->e_args[i-1];
  249.         if (arg[1] != '\0') ++arg;
  250.         else switch (arg[0]) {
  251.         case 'e': arg= "expression"; break;
  252.         case 't': arg= "target"; break;
  253.         }
  254.     }
  255.     upto(ceol, arg);
  256.     if (i == 0) a= Vnil;
  257.     else {
  258.         a= mk_compound(i);
  259.         while (--i >= 0) *Field(a, i)= args[i];
  260.     }
  261.     *v= node3(EXTENDED_COMMAND, w, a);
  262.     return Yes;
  263. }
  264.  
  265. #endif EXT_COMMAND
  266.  
  267. /* ******************************************************************** */
  268. /*        control_command                        */
  269. /* ******************************************************************** */
  270.  
  271. Forward parsetree alt_suite();
  272.  
  273. Visible bool control_command(v) parsetree *v; {
  274.     parsetree e, t; value c;
  275.     txptr ftx, ttx, utx, vtx;
  276.     skipsp(&tx);
  277.     if (if_keyword()) {
  278.             req(":", ceol, &utx, &vtx);
  279.             t= test(utx); tx= vtx;
  280.             if (!is_comment(&c)) c= Vnil;
  281.             *v= node4(IF, t, c, cmd_suite(cur_ilev, Yes));
  282.     } else if (select_keyword()) {
  283.             need(":");
  284.             c= tail_line();
  285.             *v= node3(SELECT, c, alt_suite());
  286.     } else if (while_keyword()) {
  287.             req(":", ceol, &utx, &vtx);
  288.             t= test(utx); tx= vtx;
  289.             if (!is_comment(&c)) c= Vnil;
  290.             *v= node4(WHILE, t, c, cmd_suite(cur_ilev, Yes));
  291.     } else if (for_keyword()) {
  292.             req(":", ceol, &utx, &vtx);
  293.             req(K_IN_for, ceol, &ftx, &ttx);
  294.             if (ttx > utx) {
  295.                 parerr(MESS(2004, "IN after colon"));
  296.                 ftx= utx= tx; ttx= vtx= ceol;
  297.             }
  298.             idf_cntxt= In_ranger;
  299.             t= idf(ftx); tx= ttx;
  300.             e= expr(utx); tx= vtx;
  301.             if (!is_comment(&c)) c= Vnil;
  302.             *v= node5(FOR, t, e, c, cmd_suite(cur_ilev, Yes));
  303.     } else return No;
  304.     return Yes;
  305. }
  306.  
  307. /* ******************************************************************** */
  308. /*        alternative_suite                    */
  309. /* ******************************************************************** */
  310.  
  311. Forward parsetree alt_seq();
  312.  
  313. Hidden parsetree alt_suite() {
  314.     parsetree v; bool empty= Yes;
  315.     v= alt_seq(&empty, cur_ilev, Yes, No);
  316.     if (empty) parerr(MESS(2005, "no alternative suite where expected"));
  317.     return v;
  318. }
  319.  
  320. Hidden parsetree 
  321. alt_seq(empty, cil, first, else_encountered) 
  322.     bool *empty, first, else_encountered; intlet cil;
  323. {
  324.     value c; intlet level, l;
  325.     level= ilev(); l= lino;
  326.     if (is_comment(&c)) 
  327.         return node6(TEST_SUITE, mk_integer(l), NilTree, c, NilTree,
  328.                 alt_seq(empty, cil, first, else_encountered));
  329.     if ((level == cil && !first) || (level > cil && first)) {
  330.         parsetree v, s; txptr ftx, ttx;
  331.         if (else_encountered)
  332.             parerr(MESS(2006, "after ELSE no more alternatives allowed"));
  333.         findceol();
  334.         req(":", ceol, &ftx, &ttx);
  335.         *empty= No;
  336.         if (else_keyword()) {
  337.             upto(ftx, K_ELSE); tx= ttx;
  338.             if (!is_comment(&c)) c= Vnil;
  339.             s= cmd_suite(level, Yes);
  340.             release(alt_seq(empty, level, No, Yes));
  341.             return node4(ELSE, mk_integer(l), c, s);
  342.         }
  343.         v= test(ftx); tx= ttx;
  344.         if (!is_comment(&c)) c= Vnil;
  345.         s= cmd_suite(level, Yes);
  346.         return node6(TEST_SUITE, mk_integer(l), v, c, s,
  347.                 alt_seq(empty, level, No, else_encountered));
  348.     }
  349.     veli();
  350.     return NilTree;
  351. }
  352.